home *** CD-ROM | disk | FTP | other *** search
/ Aminet 28 / Aminet 28 (1998)(GTI - Schatztruhe)[!][Dec 1998].iso / Aminet / dev / lang / fpcsrc.lha / fpc / compiler / radi386.pas < prev    next >
Pascal/Delphi Source File  |  1998-09-24  |  13KB  |  301 lines
  1. {
  2.     $Id: radi386.pas,v 1.1.1.1 1998/03/25 11:18:15 root Exp $
  3.     Copyright (c) 1998 by Florian Klaempfl
  4.  
  5.     Reads inline assembler and writes the lines direct to the output
  6.  
  7.     This program is free software; you can redistribute it and/or modify
  8.     it under the terms of the GNU General Public License as published by
  9.     the Free Software Foundation; either version 2 of the License, or
  10.     (at your option) any later version.
  11.  
  12.     This program is distributed in the hope that it will be useful,
  13.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  14.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15.     GNU General Public License for more details.
  16.  
  17.     You should have received a copy of the GNU General Public License
  18.     along with this program; if not, write to the Free Software
  19.     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20.  
  21.  ****************************************************************************
  22. }
  23. unit radi386;
  24.  
  25.   interface
  26.  
  27.     uses
  28.       tree;
  29.  
  30.      function assemble : ptree;
  31.  
  32.   implementation
  33.  
  34.      uses
  35.         i386,hcodegen,globals,scanner,aasm,
  36.         cobjects,symtable,types,verbose,asmutils;
  37.  
  38.     function assemble : ptree;
  39.  
  40.       var
  41.          retstr,s,hs : string;
  42.          c : char;
  43.          ende : boolean;
  44.          sym : psym;
  45.          code : paasmoutput;
  46.          l : longint;
  47.  
  48.        procedure writeasmline;
  49.          var
  50.            i : longint;
  51.          begin
  52.            i:=length(s);
  53.            while (i>0) and (s[i] in [' ',#9]) do
  54.             dec(i);
  55.            s[0]:=chr(i);
  56.            if s<>'' then
  57.             code^.concat(new(pai_direct,init(strpnew(s))));
  58.             { if function return is param }
  59.             { consider it set if the offset was loaded }
  60.            if assigned(procinfo.retdef) and
  61.               ret_in_param(procinfo.retdef) and
  62.               (pos(retstr,upper(s))>0) then
  63.               procinfo.funcret_is_valid:=true;
  64.            s:='';
  65.          end;
  66.  
  67.      begin
  68.        ende:=false;
  69.        s:='';
  70.        if assigned(procinfo.retdef) and
  71.           (procinfo.retdef<>pdef(voiddef)) then
  72.          retstr:=upper(tostr(procinfo.retoffset)+'('+att_reg2str[procinfo.framepointer]+')')
  73.        else
  74.          retstr:='';
  75.        c:=asmgetchar;
  76.          code:=new(paasmoutput,init);
  77.          while not(ende) do
  78.            begin
  79.               case c of
  80.                  'A'..'Z','a'..'z','_' : begin
  81.                       hs:='';
  82.                       while ((ord(c)>=ord('A')) and (ord(c)<=ord('Z')))
  83.                          or ((ord(c)>=ord('a')) and (ord(c)<=ord('z')))
  84.                          or ((ord(c)>=ord('0')) and (ord(c)<=ord('9')))
  85.                          or (c='_') do
  86.                         begin
  87.                            inc(byte(hs[0]));
  88.                            hs[length(hs)]:=c;
  89.                            c:=asmgetchar;
  90.                         end;
  91.                       if upper(hs)='END' then
  92.                          ende:=true
  93.                       else
  94.                          begin
  95.                             if c=':' then
  96.                               begin
  97.                                 getsym(upper(hs),false);
  98.                                 if srsym<>nil then
  99.                                   Message(assem_w_using_defined_as_local);
  100.                               end;
  101.                             if upper(hs)='FWAIT' then
  102.                              FwaitWarning
  103.                             else
  104.                             { access to local variables }
  105.                             if assigned(aktprocsym) then
  106.                               begin
  107.                                  { is the last written character an special }
  108.                                  { char ?                                   }
  109.                                  if (s[length(s)]<>'%') and
  110.                                    (s[length(s)]<>'$') then
  111.                                    begin
  112.                                       if assigned(aktprocsym^.definition^.localst) then
  113.                                         sym:=aktprocsym^.definition^.localst^.search(upper(hs))
  114.                                       else
  115.                                         sym:=nil;
  116.                                       if assigned(sym) then
  117.                                         begin
  118.                                            if sym^.typ=varsym then
  119.                                              begin
  120.                                              {variables set are after a comma }
  121.                                              {like in movl %eax,I }
  122.                                              if pos(',',s) > 0 then
  123.                                                pvarsym(sym)^.is_valid:=1
  124.                                              else
  125.                                              if (pos('MOV',upper(s)) > 0) and (pvarsym(sym)^.is_valid=0) then
  126.                                               Message1(sym_n_local_var_not_init_yet,hs);
  127.                                              hs:='-'+tostr(pvarsym(sym)^.address)+'('+att_reg2str[procinfo.framepointer]+')';
  128.                                              end
  129.                                            else
  130.                                            { call to local function }
  131.                                            if (sym^.typ=procsym) and (pos('CALL',upper(s))>0) then
  132.                                              begin
  133.                                                 hs:=pprocsym(sym)^.definition^.mangledname;
  134.                                              end;
  135.                                         end
  136.                                       else
  137.                                         begin
  138.                                            if assigned(aktprocsym^.definition^.parast) then
  139.                                              sym:=aktprocsym^.definition^.parast^.search(upper(hs))
  140.                                            else
  141.                                              sym:=nil;
  142.                                            if assigned(sym) then
  143.                                              begin
  144.                                                 if sym^.typ=varsym then
  145.                                                   begin
  146.                                                      l:=pvarsym(sym)^.address;
  147.                                                      { set offset }
  148.                                                      inc(l,aktprocsym^.definition^.parast^.call_offset);
  149.                                                      hs:=tostr(l)+'('+att_reg2str[procinfo.framepointer]+')';
  150.                                                      if pos(',',s) > 0 then
  151.                                                        pvarsym(sym)^.is_valid:=1;
  152.                                                   end;
  153.                                              end
  154.                                       { I added that but it creates a problem in line.ppi
  155.                                       because there is a local label wbuffer and
  156.                                       a static variable WBUFFER ...
  157.                                       what would you decide, florian ?
  158.                                       else
  159.  
  160.                                         begin
  161.                                            getsym(upper(hs),false);
  162.                                            sym:=srsym;
  163.                                            if assigned(sym) and (sym^.typ = varsym)
  164.                                               or (sym^.typ = typedconstsym) then
  165.                                              hs:=sym^.mangledname;
  166.                                            if (sym^.typ=procsym) and (pos('CALL',upper(s))>0) then
  167.                                              begin
  168.                                                 if assigned(pprocsym(sym)^.definition^.nextoverloaded) then
  169.                                                   begin
  170.                                                      exterror:=strpnew(' calling an overloaded procedure in asm');
  171.                                                      warning(user_defined);
  172.                                                   end;
  173.                                                 h